;   EPROM 28F160C3T
;
Var	CheckSum:Word;
VAR     ChipStart  : LongWord;
VAR	ChipStop   : LongWord;
VAR	BufferStart: LongWord;
VAR	Data:Word;

Frame(10,10,210,280)
  Button('/Blank'  ,20, 20,112,35,'IconDeviceBlank',Blank);
    Frame(10,59,210,2)
  Button('/Read'   ,20, 65,112,35,'IconDeviceRead',READ);
    Frame(10,104,210,2)
  Button('/Program',20,110,112,35,'IconDeviceProgram',Program);
    Frame(10,149,210,2)
  Button('/Verify' ,20,155,112,35,'IconDeviceVerify',verify);
    Frame(10,194,210,2)
  Button('/Auto'   ,20,200,112,35,'IconDeviceAuto',auto);
    Frame(10,239,210,2)
  Button('/Erase'  ,20,245,112,35,'IconDeviceErase',Erase);


equ     Check=1;
equ     unCheck=0;
Var     CheckAutoErase:Byte;
Var     CheckAutoVerify:Byte;
Var     CheckProgramVerify:Byte;
Var     OverWrite:Byte;

  CheckBox('Verify',140,119,CheckProgramVerify,1);

  CheckBox('Erase' ,140,198,CheckAutoErase,1);
  CheckBox('Verify',140,220,CheckAutoVerify,1);


Frame(590,10,185,147)
  EditHEX('Chip Start'  ,100,705, 25,58,25,ChipStart,0,0,ChipStop);
    Frame(590,59,185,2)
  EditHEX('Chip Stop'   ,100,705, 72,58,25,ChipStop,_GLOBALSIZE-1,0,_GLOBALSIZE-1);
    Frame(590,104,185,2)
  EditHEX('Buffer Start',100,705,119,58,25,BufferStart,0,0,_GLOBALBUFFERSIZE-1);


TextFrame(230,10,350,210,T1);

ProgressRect(230,230,350,15,P1);

AdresMask(25,24,23,22,21,20,19,18,   8,7,6,5,4,3,2,1,   48,17,16,15);
DataMask(29,31,33,35,38,40,42,44, 30,32,34,36,39,41,43,45);

EQU	VCC1=37;
EQU	VCC2=47;
EQU	GND1=27;
EQU	GND2=46;
EQU	VPP=13;
EQU 	CE=26;
EQU 	OE=28;
EQU 	WE=11;
EQU 	RP=12;
EQU 	WP=14;

VAR	ADRESChip:LongWord;
VAR	ADRESMemory:LongWord;
VAR	Blanked:LongWord;
VAR     DataTemp:Word;
VAR     Verify:LongWord;

BODY
 
;*******************************************************
var CData:Word;
var CAdres:LongWord;
var Temp:Word;
Procedure(Out)
        DataOut(CData);
        AdresOut(CAdres);
        PinH(OE)
        PinL(CE)
	PinL(WE)
        PinH(WE)
        PinH(CE)
EndProc;

var DataVer:Word;
Procedure(FWrite)
        Let CAdres=AdresChip;
        Let CData=040h;
        Out
        Let CData=Data;
        Out
	Loop(0);
	DataOut(0FFFFh)
@Petla:
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)
	Let Temp=DataVer;
        Let Temp and 10000000b
        if Temp=0 then
           goto petla

        Let DataVer and 00010000b
EndProc;

Procedure(FReset)
        Let CAdres=AdresChip;
        Let CData=0FFFFh;
        Out
EndProc;

Procedure(FRead)
	DataOut(0FFFFh)
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)
EndProc;

Procedure(FErase)
        Let CAdres=AdresChip;
        Let CData=020h;
        Out
        Let CData=0D0h;
        Out
	DataOut(0FFFFh)
@Petla:
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)
	Let Temp=DataVer;
        Let Temp and 10000000b
        if Temp=0 then
           goto petla
        Let DataVer and 00100000b;
EndProc;

Procedure(FEraseVerify)
        Let CAdres=AdresChip;
        Let CData=0A0h;
        Out
 	Loop(0)
	DataOut(0FFFFh)
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)
EndProc;

Procedure(Identify)
        Let CAdres=0;
        Let CData=090h;
        Out
 	Loop(0)
	DataOut(0FFFFh)
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)
        if DataVer<>_GLOBALMANUFCODE then
          begin
            TEXT(T1,'/Red/Manufacturer code ERROR!#//');
            Reset;
	    Halt;  
	  end;
	AdresOut(1);
        PinL(CE,OE)
        DataIn(DataVer)
        PinH(CE,OE)

        if DataVer<>_GLOBALDEVICECODE then
          begin
            TEXT(T1,'/Red/Device code ERROR!#//');
            Reset;
	    Halt;  
	  end;
EndProc;

var LCount:Byte;
Procedure(LockedBlockRead)
        Let CAdres=0;
        Let CData=090h;
        Out
 	Loop(0)
	DataOut(0FFFFh)

	let LCount=0;
	for LCount to 30 do
          begin
	    Let CAdres=LCount;
	    Let CAdres * 8000h;
	    Let CAdres + 2;	
            AdresOut(CAdres);

            PinL(CE,OE)
            DataIn(DataVer)
            PinH(CE,OE)
            Let DataVer and 1b;
	    Let CAdres and 0FF000h;
            if DataVer<>0 then
              begin
                TEXT(T1,'Block ');
                TEXTHEX(T1,CAdres)	
                TEXT(T1,' Locked#');
              end;        
            if DataVer=0 then
              begin
                TEXT(T1,'Block ');
                TEXTHEX(T1,CAdres)	
                TEXT(T1,' Unlocked#');
              end;        
           end; 

	let LCount=0;
	for LCount to 7 do
          begin
	    Let CAdres=LCount;
	    Let CAdres * 1000h;
	    Let CAdres or 2;	
	    Let CAdres + 0F8000h;	
            AdresOut(CAdres);

            PinL(CE,OE)
            DataIn(DataVer)
            PinH(CE,OE)
            Let DataVer and 1b;
	    Let CAdres and 0FF000h;
            if DataVer<>0 then
              begin
                TEXT(T1,'Block ');
                TEXTHEX(T1,CAdres)	
                TEXT(T1,' Locked#');
              end;        
            if DataVer=0 then
              begin
                TEXT(T1,'Block ');
                TEXTHEX(T1,CAdres)	
                TEXT(T1,' Unlocked#');
              end;        
           end; 

	FReset;
EndProc;

Procedure(UnLockedBlock)

	let LCount=0;
	for LCount to 30 do
          begin
	    Let CAdres=LCount;
	    Let CAdres * 8000h;
	    Let CAdres or 2;	

            Let CData=060h;
            Out
            Let CData=0D0h;
            Out
           end; 

	let LCount=0;
	for LCount to 7 do
          begin
	    Let CAdres=LCount;
	    Let CAdres * 1000h;
	    Let CAdres or 2;	
	    Let CAdres + 0F8000h;	

            Let CData=060h;
            Out
            Let CData=0D0h;
            Out
           end; 
EndProc;
;*******************************************************
Procedure(POWER_ON);
	TEXT(T1,'/Maroon/Waiting...#//');
	RESET
	LEDON
	VCCSET(_GLOBALVCC)
	VPPSET(_GLOBALVPP)
	PULLUP5V
        VCC(VCC1,VCC2)
        VPP(VPP)
        PINL(GND1,GND2)
        ADRESOUT(ChipStart)
        DATAOUT($FFFF)
        PINL(OE,CE)
        PINH(WE,RP,WP)
	VCCON;
	Identify;
	FReset;
	UnLockedBlock;
	FReset;
;	LockedBlockRead;
EndProc;
;*******************************************************
Procedure(POWER_OFF);
	Progress(P1,0);
	RESET
EndProc;
;*******************************************************
Procedure(BLANK);
	TEXT(T1,'#BLANK ');
  	POWER_ON;
	Let ADRESCHIP=ChipStart;
	Let ADRESMEMORY=BufferStart;
	Let Blanked=0;
	PROGRESSMAX(P1,ChipStop);
	PROGRESSMIN(P1,ChipStart);

        for AdresChip to ChipStop do
          begin
            ADRESOUT(AdresChip);
            PinL(CE,OE)
            DATAIN(Data);
            PinH(CE,OE)
            IF DATA<>$FFFF THEN
              Inc(Blanked);
            Progress(P1,AdresChip);
          end;

	if blanked<>0 then
          begin 	
            TEXT(T1,'/Red//Under/WARNING !// CHIP NOT BLANK.#')	
            TEXT(T1,'/Navy blue/')	
            TEXTHEX(T1,Blanked)	
            TEXT(T1,' //word <> FFFFh.#')	

            POWER_OFF
            Halt
          end;

	TEXT(T1,'/Under/OK!// CHIP BLANK#')	

	POWER_OFF
EndProc;
;*******************************************************
Procedure(READ);
	TEXT(T1,'#READ ');
  	POWER_ON;

	Let ADRESCHIP=ChipStart;
	Let ADRESMEMORY=BufferStart;
	LET Blanked=0;
	Let CheckSum=0;
	PROGRESSMAX(P1,ChipStop);
	PROGRESSMIN(P1,ChipStart);

        for AdresChip to ChipStop do
          begin
            ADRESOUT(ADRESChip);
            PinL(CE,OE)
            DATAIN(Data);
            PinH(CE,OE)
            MEMORYOUT(ADRESMemory,Data);
	    Let CheckSum+Data;
            IF DATA<>$FFFF THEN
              Inc(Blanked);
            INC(ADRESMemory);
            Progress(P1,AdresChip);
          end;

	if blanked<>0 then
          begin 	
            TEXT(T1,'/Navy blue/')	
            TEXTHEX(T1,Blanked)	
            TEXT(T1,'// word <> FFFFh. ')	
          end;
	Text(T1,'/Under/OK!//')	

	Text(T1,' Crc=');
	TextHex(T1,CheckSum);
	Text(T1,'h#');

	POWER_OFF
EndProc;
;*******************************************************
Var	AdrError:LongWord;
Var	DataBufferError:Word;
Var	DataChipError:Word;
Var	MarkError:Byte

Equ	Marked    = 1;
Equ	NotMarked = 0;

Procedure(Verify);
	TEXT(T1,'#VERIFY ');
  	POWER_ON;
	Let ADRESCHIP=ChipStart;
	Let ADRESMEMORY=BufferStart;
	Let Verify=0;
	Let MarkError=NotMarked;

	PROGRESSMAX(P1,ChipStop);
	PROGRESSMIN(P1,ChipStart);

        for AdresChip to ChipStop do
          begin
            ADRESOUT(AdresChip);
            PinL(CE,OE)
            DATAIN(Data);
            PinH(CE,OE)
            CompareOut(AdresMemory,Data);
            MemoryIn(AdresMemory,DataTemp);
            IF DATA<>DataTemp THEN
              begin
                Inc(Verify);
                  if MarkError=NotMarked then
                    begin
                      Let AdrError=AdresChip;
                      Let DataBufferError=DataTemp;
                      Let DataChipError=Data; 	
                      Let MarkError=Marked;
                   end;
              end;
            INC(AdresMemory);
            Progress(P1,AdresChip);
	  end;

        if verify<>0 then
          begin 	
            TEXT(T1,'/Red//Under/ERROR !// Verify #')	
            TEXT(T1,'/Navy blue/')	
            TEXTHEX(T1,Verify)	
            TEXT(T1,' //byte bad value#')	

            TEXT(T1,'First error:#')	
            TEXT(T1,'ChipAdres ChipData MemoryData#/Navy blue/')	
            TEXTHEX(T1,AdrError)	
            TEXT(T1,'h ')	
            TEXTHEX(T1,DataChipError)	
            TEXT(T1,'h      ')	
            TEXTHEX(T1,DataBufferError)	
            TEXT(T1,'h #//')	

            POWER_OFF
            exit
          end

	TEXT(T1,'/Under/OK!// CHIP Verify#')	

	POWER_OFF
EndProc;
;*******************************************************
var Counter1:Word;
var Counter2:Word;
procedure(Erase);
	TEXT(T1,'#ERASE ');
  	POWER_ON;
	VPPON;

	PROGRESSMAX(P1,_GLOBALSIZE-1);
	PROGRESSMIN(P1,0);

	Let Counter2=0
        for Counter2 to 30 do
          begin
	    Let AdresChip=Counter2;
            Let AdresChip*8000h;
            Progress(P1,AdresChip);
            FErase;
	    If DataVer<>0 then
              goto Error
          end;

	Let Counter2=0
        for Counter2 to 7 do
          begin
	    Let AdresChip=Counter2;
            Let AdresChip*1000h;
            Let AdresChip+0F8000h;
            Progress(P1,AdresChip);
            FErase;
	    If DataVer<>0 then
              goto Error
          end;

        VPPOFF;

        TEXT(T1,'/Under/OK!// CHIP Erased#')	
        POWER_OFF
	exit;

@Error:
        Text(T1,'/Red//Under/Error!//#');
        TEXT(T1,'BlockAdres ')	
        Text(T1,'/Navy blue/');
        TEXTHEX(T1,AdresChip)	
        TEXT(T1,'h #//')	
        POWER_OFF
        Halt;  
EndProc;

;*******************************************************
procedure(ProgramLoop);
	TEXT(T1,'#PROGRAM ');
  	POWER_ON;
	VPPON;

	Let ADRESCHIP=ChipStart;
	Let ADRESMEMORY=BufferStart;
	PROGRESSMAX(P1,ChipStop);
	PROGRESSMIN(P1,ChipStart);

        for AdresChip to ChipStop do 
          begin
            MEMORYIN(AdresMemory,Data);
            FWrite;
            if DataVer<>0 then
              begin
                Text(T1,'/Red//Under/Error!//#');
                TEXT(T1,'ChipAdres MemoryData#')	
                Text(T1,'/Navy blue/');
                TEXTHEX(T1,AdresChip)	
                TEXT(T1,'h ')	
                TEXTHEX(T1,Data)	
                TEXT(T1,'h #//')	
                POWER_OFF
	        Halt;  
              end;

            INC(ADRESMemory);
            Progress(P1,AdresChip);
          end;

          TEXT(T1,'/Under/OK!// CHIP Program#')	
          POWER_OFF
EndProc;

procedure(Program);
        ProgramLoop;
        if CheckProgramVerify=Check then
          Verify
EndProc;
;*******************************************************
procedure(Auto)
	TEXT(T1,'#AUTO ');
        if CheckAutoErase=Check then
          Erase

        ProgramLoop;

        if CheckAutoVerify=Check then
          Verify

        Serialize; 

        TEXT(T1,'#/Under/OK!// AUTO#')	
endproc
;*******************************************************
end.
